home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s1.arc / KREC1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-05  |  11.9 KB  |  323 lines
  1. (*----------------------------------------------------------------------*)
  2. (*             Get_Char --- Get character for Kermit packet             *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Get_Char( VAR Ch : INTEGER );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Get_Char                                             *)
  10. (*                                                                      *)
  11. (*     Purpose:    Gets character for Kermit packet                     *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Get_Char( VAR Ch: INTEGER );                                  *)
  16. (*                                                                      *)
  17. (*           Ch --- returned character                                  *)
  18. (*                                                                      *)
  19. (*     Calls:                                                           *)
  20. (*                                                                      *)
  21. (*        Async_Receive                                                 *)
  22. (*                                                                      *)
  23. (*----------------------------------------------------------------------*)
  24.  
  25. VAR
  26.    Temp          : INTEGER;
  27.    Rec_Stat_Flag : BOOLEAN;
  28.    A_Ch          : CHAR;
  29.  
  30. BEGIN (* Get_Char *)
  31.  
  32.    Temp         := 0;
  33.    Kermit_Abort := FALSE;
  34.    Kermit_Retry := FALSE;
  35.                                    (* Loop until char found from *)
  36.                                    (* comm port or keyboard      *)
  37.    REPEAT
  38.                                    (* Pick up a character from comm port, *)
  39.                                    (* if any.                             *)
  40.  
  41.       Async_Receive_With_TimeOut( His_TimeOut , Ch );
  42.  
  43.                                    (* If we timed out, indicate retry *)
  44.                                    (* should be done.                 *)
  45.       IF ( Ch = TimeOut ) THEN
  46.          BEGIN
  47.             Kermit_Retry  := TRUE;
  48.             Rec_Stat_Flag := FALSE;
  49.             Ch            := 0;
  50.          END
  51.       ELSE
  52.          Rec_Stat_Flag := TRUE;
  53.  
  54.                                    (* Pick up keyboard entry, if any.     *)
  55.       IF KeyPressed THEN
  56.          BEGIN
  57.  
  58.             READ( Kbd, A_Ch );
  59.  
  60.             IF ( ORD( A_Ch ) = ESC ) AND KeyPressed THEN
  61.                READ( Kbd, A_Ch );
  62.  
  63.             IF ( ( ORD( A_Ch ) = ALT_R ) AND ( NOT Sending_File ) ) OR
  64.                ( ( ORD( A_Ch ) = ALT_S ) AND (     Sending_File ) ) THEN
  65.                A_Ch := CHR( ETX );
  66.  
  67.          END
  68.       ELSE
  69.          A_CH := CHR( 0 );
  70.  
  71.       Temp := ORD( A_Ch );
  72.                                    (* Keyboard entry can be Alt_R or  *)
  73.                                    (* Alt_S to halt transfer or CR to *)
  74.                                    (* force end of packet.            *)
  75.       IF ( Temp <> 0 ) THEN
  76.          CASE Temp OF
  77.             ETX : Kermit_Abort := TRUE;
  78.             CR  : Kermit_Retry := TRUE;
  79.             ELSE ;
  80.          END (* CASE *);
  81.  
  82.    UNTIL ( Rec_Stat_Flag OR Kermit_Abort OR Kermit_Retry );
  83.  
  84. END    (* Get_Char *);
  85.  
  86. (*----------------------------------------------------------------------*)
  87. (*                Receive_Packet --- Receive Kermit packet              *)
  88. (*----------------------------------------------------------------------*)
  89.  
  90. PROCEDURE Receive_Packet;
  91.  
  92. (*----------------------------------------------------------------------*)
  93. (*                                                                      *)
  94. (*     Procedure:  Receive_Packet                                       *)
  95. (*                                                                      *)
  96. (*     Purpose:    Gets Kermit packet                                   *)
  97. (*                                                                      *)
  98. (*     Calling Sequence:                                                *)
  99. (*                                                                      *)
  100. (*        Receive_Packet;                                               *)
  101. (*                                                                      *)
  102. (*     Calls:                                                           *)
  103. (*                                                                      *)
  104. (*        Get_Char                                                      *)
  105. (*        Get_P_Length                                                  *)
  106. (*        Kermit_CRC                                                    *)
  107. (*                                                                      *)
  108. (*     Remarks:                                                         *)
  109. (*                                                                      *)
  110. (*        A Kermit packet starts with an SOH character, followed by a   *)
  111. (*        packet length, then the block number MOD 64, then the packet  *)
  112. (*        data, and finally a checksum or crc.                          *)
  113. (*                                                                      *)
  114. (*----------------------------------------------------------------------*)
  115.  
  116. VAR
  117.    Rec_Char        : INTEGER;
  118.    B_Rec_Char      : BYTE;
  119.    Temp            : INTEGER;
  120.    Check_Char      : CHAR;
  121.    Check_OK        : BOOLEAN;
  122.    CheckSum        : INTEGER;
  123.    Count           : INTEGER;
  124.    Index           : INTEGER;
  125.    StrNum          : STRING[3];
  126.    Chk1            : CHAR;
  127.    Chk2            : CHAR;
  128.    Chk3            : CHAR;
  129.    Check_Type      : INTEGER;
  130.    L_Packet        : INTEGER;
  131.  
  132. (*----------------------------------------------------------------------*)
  133. (*             Get_P_Length --- Get length of Kermit packet             *)
  134. (*----------------------------------------------------------------------*)
  135.  
  136. PROCEDURE Get_P_Length;
  137.  
  138. BEGIN (* Get_P_Length *)
  139.  
  140.    IF NOT ( Kermit_Abort OR Kermit_Retry ) THEN
  141.       BEGIN
  142.          Get_Char( Rec_Char );
  143.          Count    := Rec_Char - 32;
  144.       END;
  145.  
  146. END   (* Get_P_Length *);
  147.  
  148. (*----------------------------------------------------------------------*)
  149.  
  150. FUNCTION SIval( I: INTEGER ) : ShortStr;
  151.  
  152. VAR
  153.    IWidth : INTEGER;
  154.    ISave  : INTEGER;
  155.    S      : ShortStr;
  156.  
  157. BEGIN (* SIval *)
  158.  
  159.    IWidth := 0;
  160.    ISave  := I;
  161.  
  162.    WHILE( ISave > 0 ) DO
  163.       BEGIN
  164.          IWidth := IWidth + 1;
  165.          ISave  := ISave DIV 10;
  166.       END;
  167.  
  168.    STR( I : IWidth , S );
  169.  
  170.    SIVal := S;
  171.  
  172. END   (* SIval *);
  173.  
  174. (*----------------------------------------------------------------------*)
  175.  
  176. BEGIN (* Receive_Packet *)
  177.  
  178.    Rec_Packet := '';
  179.    Check_OK   := FALSE;
  180.    Packet_OK  := FALSE;
  181.    Check_Type := ORD( His_Chk_Type ) - ORD('0');
  182.  
  183.                                    (* Wait for header character (SOH) *)
  184.  
  185.    REPEAT  (* get header character *)
  186.       Get_Char( Rec_Char );
  187.    UNTIL ( ( Rec_Char = ORD( Kermit_Header_Char ) ) OR
  188.             Kermit_Abort OR Kermit_Retry );
  189.  
  190.                                    (* Get packet length *)
  191.    Get_P_Length;
  192.                                    (* Get rest of packet *)
  193.  
  194.    IF NOT ( Kermit_Abort OR Kermit_Retry ) THEN
  195.       BEGIN (* NOT ( Abort OR Retry ) *)
  196.          REPEAT
  197.                                    (* Packet type and data *)
  198.             Get_Char( Rec_Char );
  199.  
  200.             IF ( Rec_Char = ORD( Kermit_Header_Char ) ) THEN
  201.                BEGIN  (* got new start of packet *)
  202.  
  203.                                    (* Packet is initially empty *)
  204.                   Rec_Packet := '';
  205.                   Get_P_Length;
  206.  
  207.                END
  208.             ELSE  (* must be a character *)
  209.                BEGIN
  210.                   Rec_Packet := Rec_Packet + CHR( Rec_Char );
  211.                   Count      := Count - 1;
  212.                END;
  213.  
  214.          UNTIL ( Kermit_Abort OR Kermit_Retry OR ( Count = 0 ) );
  215.  
  216.                                    (* Update packets received *)
  217.  
  218.       Packets_Received := Packets_Received + 1;
  219.  
  220.                                    (* Update display *)
  221.       Update_Kermit_Display;
  222.  
  223.       IF ( NOT Kermit_Abort ) THEN
  224.          BEGIN  (* NOT Abort *)
  225.                                    (* Compute and check checksum or crc *)
  226.  
  227.             L_Packet := LENGTH( Rec_Packet );
  228.  
  229.             CASE His_Chk_Type OF
  230.  
  231.                '1': BEGIN
  232.  
  233.                        CheckSum := L_Packet + 32;
  234.  
  235.                        FOR Index := 1 TO ( L_Packet - 1 ) DO
  236.                           CheckSum := CheckSum + ORD( Rec_Packet[Index] );
  237.  
  238.                        CheckSum := ( ( CheckSum + ( ( CheckSum AND 192 ) SHR 6 ) ) AND 63 );
  239.  
  240.                        Chk1     := Kermit_Char40( CheckSum );
  241.  
  242.                        Check_OK := ( Chk1 = Rec_Packet[ L_Packet ] );
  243.  
  244.                    END;
  245.  
  246.               '2': BEGIN
  247.  
  248.                       CheckSum := L_Packet + 32;
  249.  
  250.                       FOR Index := 1 TO ( L_Packet - 2 ) DO
  251.                          CheckSum := CheckSum + ORD( Rec_Packet[Index] );
  252.  
  253.                       CheckSum        := CheckSum AND 4095;
  254.  
  255.                       Chk1 := Kermit_Char40( CheckSum SHR 6  );
  256.                       Chk2 := Kermit_Char40( CheckSum AND 63 );
  257.  
  258.                       Check_OK := ( Chk1 = Rec_Packet[ L_Packet - 1 ] ) AND
  259.                                   ( Chk2 = Rec_Packet[ L_Packet     ] );
  260.  
  261.                   END;
  262.  
  263.              '3': BEGIN
  264.  
  265.                       B_Rec_Char := L_Packet + 32;
  266.                       CheckSum   := 0;
  267.                       CheckSum   := Kermit_CRC( CheckSum , B_Rec_Char );
  268.  
  269.                       FOR Index := 1 TO ( L_Packet - 3 ) DO
  270.                          BEGIN
  271.                             B_Rec_Char := ORD( Rec_Packet[Index] );
  272.                             CheckSum   := Kermit_CRC( CheckSum , B_Rec_Char );
  273.                          END;
  274.  
  275.                       Chk1 := Kermit_Char40( ( CheckSum SHR 12 ) AND 15 );
  276.                       Chk2 := Kermit_Char40( ( CheckSum SHR 6  ) AND 63 );
  277.                       Chk3 := Kermit_Char40( CheckSum AND 63   );
  278.  
  279.                       Check_OK := ( Chk1 = Rec_Packet[ L_Packet - 2 ] ) AND
  280.                                   ( Chk2 = Rec_Packet[ L_Packet - 1 ] ) AND
  281.                                   ( Chk3 = Rec_Packet[ L_Packet     ] );
  282.  
  283.                   END;
  284.  
  285.             END (* CASE *);
  286.                                    (* Get packet number *)
  287.  
  288.             Rec_Packet_Num := Kermit_UnChar( Rec_Packet[1] );
  289.  
  290.                                    (* Set next state based upon packet type *)
  291.  
  292.             CASE Rec_Packet[2] OF
  293.                'B' : Kermit_Packet_Type := Break_Pack;
  294.                'D' : Kermit_Packet_Type := Data_Pack;
  295.                'E' : Kermit_Packet_Type := Error_Pack;
  296.                'F' : Kermit_Packet_Type := Header_Pack;
  297.                'N' : Kermit_Packet_Type := NAK_Pack;
  298.                'S' : Kermit_Packet_Type := Send_Pack;
  299.                'T' : Kermit_Packet_Type := Reserved_Pack;
  300.                'Y' : Kermit_Packet_Type := ACK_Pack;
  301.                'Z' : Kermit_Packet_Type := End_Pack;
  302.                ELSE  Kermit_Packet_Type := Unknown;
  303.             END (* CASE *);
  304.  
  305.                                    (* Strip type, #, checksum from packet *)
  306.  
  307.             IF ( LENGTH( Rec_Packet ) > ( Check_Type + 2 ) ) THEN
  308.                BEGIN
  309.                   DELETE( Rec_Packet, 1, 2 );
  310.                   DELETE( Rec_Packet, LENGTH( Rec_Packet ) - Check_Type + 1,
  311.                           Check_Type );
  312.                END;
  313.                                     (* Set flag if packet OK *)
  314.  
  315.             IF ( Check_OK AND ( Kermit_Packet_Type <> Unknown ) ) THEN
  316.                Packet_OK := TRUE;
  317.  
  318.          END  (* NOT Abort *);
  319.  
  320.       END  (* NOT ( Abort OR Retry ) *);
  321.  
  322. END   (* Receive_Packet *);
  323.